perm filename EULER[G,BGB] blob
sn#087659 filedate 1974-02-19 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00027 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE EULER - EULER PRIMITIVES - JULY 1972.
C00005 00003 SUBR(INVERT)
C00007 00004 SUBR(MKEV,FACE,VERTEX)
C00009 00005 SUBR(MKFE,VERT1,FACE,VERT2)
C00012 00006 MKFE - CONTINUED.
C00014 00007 SUBR(ESPLIT,EDGE)
C00016 00008 SUBR(KLFE)
C00018 00009 SUBR(KLEV)
C00021 00010 SUBR(KLVE)
C00023 00011 SUBR(MKCOPY,BODY)
C00026 00012 (MKCOPY continued)
C00029 00013 SUBR(UNGLUE,EDGE)
C00031 00014
C00033 00015 SUBR(GLUEE,FACE1,VERT1,FACE2,VERT2)
C00035 00016 COMMENT . GLUEE MANDALA
C00037 00017 SUBR(GLUE)F1,F2
C00040 00018 SUBR(SWEEP,FACE0,FLAG)
C00043 00019 SUBR(SWEEP2,FACE0,FLAG)
C00046 00020 SUBR(ROTCOM,FACE0) ROTATION SWEEP COMPLETION.
C00048 00021 SUBR(PYRAMID,FV) MAKE PYRAMID.
C00050 00022 SUBR(REMOVF,FACE)
C00052 00023 SUBR(EKILL,EDGE)
C00054 00024 SUBR(FVDUAL,BODY)
C00056 00025 SUBR(MKCUBE,DX,DY,DZ)
C00058 00026 SUBR(MKCYLN,RADIUS,N,DZ)
C00060 00027 SUBR(MKBALL,RADIUS,M,N)
C00062 ENDMK
C⊗;
TITLE EULER - EULER PRIMITIVES - JULY 1972.
COMMENT /
These primitives preserve the Euler Equation F-E+V = 2*B-2*H;
INVERT(E); "|" COMMAND.
EVERT(B); "¬" COMMAND.
VNEW ← MKEV(F,V); "E" COMMAND.
ENEW ← MKFE(V1,F,V2); "J" COMMAND.
VNEW ← ESPLIT(E); "M" COMMAND.
F ← KLFE(ENEW); "K" COMMAND.
E ← KLEV(VNEW); "K" COMMAND.
V ← KLVE(ENEW); "αK" COMMAND.
BNEW ← MKCOPY(B); "C" COMMAND.
ENEW ← GLUEE(F1,V1,F2,V2); "J" COMMAND.
/
;THE EULER PRIMITVES ARE DEPENDENT ON THE WING OPERATIONS.
EXTERN MKNODE,KLNODE
EXTERN MKB,MKF,MKE,MKV
EXTERN KLB,KLF,KLE,KLV,WING
EXTERN WING,LINKED
EXTERN ECW,ECCW,OTHER
EXTERN BGET,FCW,FCCW,VCW,VCCW
EXTERN BATT,BDET
;BIT FOR MARKING EDGES OF A WASP FACE'S WAIST.
↓WASP←←1B5
SUBR(INVERT)
COMMENT ⊗-----------------------------------------------------------
⊗
LAC 1,ARG1
MOVSS 1(1)↔MOVSS 3(1)↔MOVSS 4(1)↔MOVSS 5(1)
MOVNS -3(1)↔MOVNS -2(1)↔MOVNS -1(1)
POP1J
ENDR;1/14/73(BGB)---------------------------------------------------
SUBR(EVERT,BODY) ;TURN BODY INSIDE OUT.
COMMENT ⊗-----------------------------------------------------------
⊗
ACCUMULATORS{B,E}
CDR B,ARG1
TEST B,BBIT↔POP1J
LAC E,B
L1: PED E,E
TEST E,EBIT↔GO L3
MOVSS 1(E)
MOVS 4(E)↔MOVS 1,5(E)
DAC 1,4(E)↔DAC 5(E)
GO L1
;PARTS OF THIS BODY.
L3: SON 1,B↔JUMPE 1,POP1J.
L4: PUSH P,1↔CALL(EVERT,1)
POP P,1↔LAC B,ARG1
BRO 1,1↔SON 0,B
CAME 0,1↔GO L4↔POP1J
ENDR;1/14/73(BGB)---------------------------------------------------
SUBR(MKEV,FACE,VERTEX)
COMMENT ⊗-----------------------------------------------------------
⊗
ACCUMULATORS {VNEW,B,F,V,ENEW,E1,E2}
;CHECK FOR BAD ARGUMENTS.
CDR VNEW,ARG1;FOR BAD RETURNS.
LAC V,ARG1↔TEST(V,VBIT)↔POP2J
LAC F,ARG2↔TEST(F,FBIT)↔POP2J
;CREATE A NEW EDGE AND VERTEX.
SETQ(B,{BGET,V})
SETQ(VNEW,{MKV,B})
MOVSI XWC(V)↔HRRI XWC(VNEW)↔BLT ZWC(VNEW)
MOVSI XPP(V)↔HRRI XPP(VNEW)↔BLT YPP(VNEW)
LAC 1(V)↔DAC 1(VNEW)
SETQ(ENEW,{MKE,B})
;MAKE FACE AND VERTEX LINKS.
PED. ENEW,VNEW
NFACE. F,ENEW
PFACE. F,ENEW
NVT. VNEW,ENEW
PVT. V,ENEW
;CHECK FOR VERTEX BODY CASE.
PED E1,F↔JUMPE E1,[
PED. ENEW,F↔PED. ENEW,V
PCW. ENEW,ENEW↔NCCW. ENEW,ENEW↔GO .+1]
;LOWER WINGS POINT AT SELF.
NCW. ENEW,ENEW
PCCW. ENEW,ENEW
;GET THE UPPER WINGS.
PED E1,V↔LAC E2,E1
NFACE 0,E1↔PFACE 1,E1
CAMN 0,1↔GO L2
L1: LAC E1,E2
SETQ(E2,{ECW,E1,V})
CALL(FCW,E1,V)
CAME 1,F↔GO L1
;TIE ENEW TO ITS UPPER WINGS.
L2: PCW. E1,ENEW↔NCCW. E2,ENEW
PVT 0,E1↔CAME 0,V↔GO[PCCW. ENEW,E1↔GO .+2]↔NCCW. ENEW,E1
PVT 0,E2↔CAME 0,V↔GO[NCW. ENEW,E2↔GO .+2]↔PCW. ENEW,E2
LAC 1,VNEW↔POP2J
ENDR MKEV;1/14/73(BGB)-----------------------------------------------
SUBR(MKFE,VERT1,FACE,VERT2)
COMMENT .-----------------------------------------------------------
MKFE MANDALA
o--------o o--------o
| E2 \ / E1 |
| nccw \ / pcw |
| \ / |
| pvt ⊗ V1 |
| | |
| FNEW ENEW F |
| | |
| nvt ⊗ V2 |
| / \ |
| ncw / \ pccw |
| E3 / \ E4 |
o--------o o--------o .
ACCUMULATORS{V1,F,V2,FNEW,ENEW,E,E0,B,V}
;FETCH THE ARGUMENTS.
CDR V1,ARG3
CDR F,ARG2
CDR V2,ARG1
;DO THE CREATIONS.
SETQ(B,{BGET,F})
SETQ(FNEW,{MKF,B})
SETQ(ENEW,{MKE,B})
LAC 4(F)↔DAC 4(FNEW)
LAC 5(F)↔DAC 5(FNEW)
MOVSI AA(F)↔HRRI AA(FNEW)↔BLT CC(FNEW)
;LINK ENEW.
PED. ENEW,F↔ PED. ENEW,FNEW
PFACE. F,ENEW↔ NFACE. FNEW,ENEW
PVT. V1,ENEW↔ NVT. V2,ENEW
;GET THE UPPER WINGS.
PED E,V1↔DAC E,E0↔DAC E,EDGE0#
MOVS 1(E)↔CAMN 1(E)↔GO L1A ;WIRE CASE.
L1: LAC E0,E↔SETQ(E,{ECW,E0,V1})
CALL(FCW,E0,V1)↔CAME 1,F↔GO[
CAME E,EDGE0↔GO L1↔FATAL(MKFE - V1 HAS NO WINGS)]
L1A: DAC E0,E1#↔DAC E,E2#
;GET THE LOWER WINGS.
PED E,V2↔DAC E,E0↔DAC E,EDGE0#
MOVS 1(E)↔CAMN 1(E)↔GO L2A ;WIRE CASE.
L2: LAC E0,E↔SETQ(E,{ECW,E0,V2})
CALL(FCW,E0,V2)↔CAME 1,F↔GO[
CAME E,EDGE0↔GO L2↔FATAL(MKFE - V2 HAS NO WINGS)]
L2A: DAC E0,E3#↔DAC E,E4#
;MKFE - CONTINUED.
;CDR V2'S TAIL REPLACING F'S WITH FNEW.
LAC E,E3↔LAC V,V2
L3: MOVS 1,1(E)↔CAME 1,1(E)↔GO L4
PFACE. FNEW,E
SETQ(V,{OTHER,E,V})
SETQ(E,{ECCW,E,V})↔GO L3
;CCW FROM V1 REPLACING F'S WITH FNEW.
L4: LAC E0,E↔LAC E,E2↔SETZM A#↔CAMN E0,E2↔GO L6
L5: TESTZ E,WASP↔JSR WASPS
NFACE 0,E
CAME F,0
GO[PFACE. FNEW,E↔GO .+2]
NFACE. FNEW,E
CAME E,E0
GO[DAC E,A↔SETQ(E,{ECCW,E,FNEW})↔GO L5]
;LINK THE WINGS.
L6: CALL(WING,E1,ENEW)
CALL(WING,E2,ENEW)
CALL(WING,E3,ENEW)
CALL(WING,E4,ENEW)
L7: LAC 1,ENEW↔POP3J
WASPS: 0
PCW 1,E↔CAMN 1,A↔GO W1
PCCW 1,E↔CAME 1,A↔GO W2
W1: SETZM A↔MARKZ E,WASP
PFACE. FNEW,E↔SETQ(E,{ECCW,E,FNEW})
TESTZ E,WASP↔GO W1↔GO @WASPS
W2: SETZM A↔MARKZ E,WASP
NFACE. FNEW,E↔SETQ(E,{ECCW,E,FNEW})
TESTZ E,WASP↔GO W2↔GO @WASPS
ENDR;1/14/73(BGB)----------------------------------------------------
SUBR(ESPLIT,EDGE)
COMMENT ⊗-----------------------------------------------------------
⊗
ACCUMULATORS{VNEW,ENEW,B,E,V}
;CHECK FOR BAD ARGUMENTS.
CDR VNEW,EDGE
LAC E,VNEW
TEST E,EBIT↔GO L1
PVT V,E
;CREATE A NEW EDGE AND VERTEX.
CCW B,E
SETQ(VNEW,{MKV,B})
SETQ(ENEW,{MKE,B})
MOVSI AA(E)↔HRRI AA(ENEW)↔BLT CC(ENEW)
;PLACE VNEW BETWEEN E AND ENEW.
PED 0,V↔CAMN 0,E↔PED. ENEW,V
PED. ENEW,VNEW
PVT 0,E↔PVT. 0,ENEW
PVT. VNEW,E
NVT. VNEW,ENEW
PFACE 0,E↔PFACE. 0,ENEW
NFACE 0,E↔NFACE. 0,ENEW
;NEW UPPER WINGS ARE LIKE THE OLDE;
PCW 0,E↔CALL(WING,0,ENEW)
NCCW 0,E↔CALL(WING,0,ENEW)
;EDGES POINT AT EACH OTHER ACROSS VNEW.
NCCW. ENEW,E↔PCW. ENEW,E
NCW. E,ENEW↔PCCW. E,ENEW
L1: LAC 1,VNEW↔POP1J
ENDR;1/14/73(BGB)-----------------------------------------------------
SUBR(KLFE)
COMMENT ⊗-----------------------------------------------------------
⊗
ACCUMULATORS{ENEW,FNEW,V1,V2,E1,E2,E3,E4,E,F,B}
;PICK THINGS UP.
CDR ENEW,ARG1
PFACE F,ENEW↔ NFACE FNEW,ENEW
PVT V1,ENEW↔ NVT V2,ENEW
;TEST FOR WASP EDGE CASE.
CAME F,FNEW↔GO L0
CALL(UNGLUE,ENEW)
POP1J
;GET THE WINGS.
L0: PCW E1,ENEW
NCCW E2,ENEW
NCW E3,ENEW
PCCW E4,ENEW
;GET RID OF ENEW APPEARANCES IN F & V.
PED 0,V1↔ CAMN 0,ENEW↔ PED. E1,V1
PED 0,V2↔ CAMN 0,ENEW↔ PED. E3,V2
PED 0,F ↔ CAMN 0,ENEW↔ PED. E3,F
;GET RID OF FNEW APPEARANCES
LAC E,E2
L1: CALL(ECCW,E,FNEW) ;GET NEXT EDGE ABOUT FNEW.
PFACE 0,E↔CAMN 0,FNEW↔GO[PFACE. F,E↔GO L2]
NFACE 0,E↔CAMN 0,FNEW↔GO[NFACE. F,E↔GO L2]
FATAL(KLFE)
L2: CAME E,E3↔GO[DAC 1,E↔GO L1]
;LINK WINGS TOGETHER ABOUT F.
CALL(WING,E2,E1)
CALL(WING,E4,E3)
;GET RID OF FNEW AND ENEW.
CCW B,ENEW
CALL(KLF,B,FNEW)
CALL(KLE,B,ENEW)
LAC 1,F↔POP1J
ENDR;1/14/73(BGB)----------------------------------------------------
SUBR(KLEV)
COMMENT .-----------------------------------------------------------
\ pvt / KLEV MANDALA
\ /
nccw \ / pcw
\ /
V ⊗
|
ENEW |
| nvt
VNEW ⊗
| pvt
E |
|
⊗
/ \
ncw / \ pccw
/ \
/ nvt \ .
ACCUMULATORS{E,ENEW,V,VNEW,F,B}
CDR VNEW,ARG1↔PED ENEW,VNEW
SETQ(E,{ECCW,ENEW,VNEW})
CAMN E,ENEW↔GO[SETQ(V,{OTHER,ENEW,VNEW}) ;EAT WIRE.
SETQ(E,{ECCW,ENEW,V})↔NCW. E,E↔PCCW. E,E↔GO L1]
CALL(ECCW,E,VNEW)↔CAME 1,ENEW
GO[CALL(KLFE,1)↔GO KLEV]
;ORIENT EDGES AS IN MANDALA.
NVT 0,ENEW↔CAMN 0,VNEW↔GO .+3↔CALL(INVERT,ENEW)
PVT 0,E↔CAMN 0,VNEW↔GO .+3↔CALL(INVERT,E)
;TIE E TO ITS NEW VERTEX.
PVT V,ENEW↔ PVT. V,E
;MAKE E'S UPPER WINGS LIKE ENEW'S.
PCW 0,ENEW↔CALL(WING,0,E)
NCCW 0,ENEW↔CALL(WING,0,E)
;ELIMINATE OCCURENCES OF ENEW IN F & V.
L1: PED 0,V↔ CAMN 0,ENEW↔ PED. E,V
PFACE F,E↔ PED 0,F↔ CAMN 0,ENEW↔ PED. E,F
NFACE F,E↔ PED 0,F↔ CAMN 0,ENEW↔ PED. E,F
;PURGE 'EM.
CCW B,ENEW
CALL(KLV,B,VNEW)
CALL(KLE,B,ENEW)
LAC 1,E↔MOVS 1(1)↔CAMN 1(1)↔NVT 1,1
POP1J
ENDR;1/14/73(BGB)----------------------------------------------------
SUBR(KLVE)
COMMENT .-----------------------------------------------------------
V ← KLVE(E) - KILL E & NVT(E) RETURNING PVT(E)
E2 \ / E1
nccw \ / pcw
\ /
pvt ⊗ V2
|
| E
|
nvt ⊗ V1
/ \
ncw / \ pccw
E3 / \ E4.
ACCUMULATORS{A,E,E1,E2,E3,E4,V1,V2,S12}
;PICK THINGS UP.
CDR E,ARG1↔NVT V1,E↔PVT V2,E
PCW E1,E↔NCCW E2,E↔NCW E3,E↔PCCW E4,E
;REPLACE FACE-VERTEX PED'S THAT MIGHT CONTAIN E.
PFACE 1,E↔PED 0,1↔CAMN 0,E↔PED. E1,1
NFACE 1,E↔PED 0,1↔CAMN 0,E↔PED. E2,1
PED 0,V2↔CAMN 0,E↔PED. E2,V2
;REPLACE V1 WITH V2.
LAC A,E3
L1: PVT 1,A↔CAME 1,V1↔GO[NVT. V2,A↔GO .+2]↔PVT. V2,A
SETQ(A,{ECCW,A,V2})
CAME A,E↔GO L1
;SPLICE WINGS TOGETHER.
CALL(WING,E1,E4)
CALL(WING,E2,E3)
;BURN THE GARBAGE.
CCW A,E
CALL(KLE,A,E)
CALL(KLV,A,V1)
LAC 1,V2
POP1J
LIT
ENDR;1/14/73(BGB)-----------------------------------------------------
SUBR(MKCOPY,BODY)
COMMENT ⊗-----------------------------------------------------------
⊗
ACCUMULATORS{B,F,E,V,BNEW,Q,A}
EXTERN MKFRAME
LAC B,BODY
;DETECT AND COPY FRAME NODES
MOVM 1,(B) ;GET ABS(TYPE(NODE))
SKIPE 1↔TLNE 1,(<1B9>) ;IF ZERO OR BIT 9, THEN FLOATING
GO[ CALL(MKNODE,[0]) ;COPY FRAME NODE AND RETURN IT
MOVSI XWC(B)↔HRRI XWC(1)↔BLT KZ(1)
POP1J]
;IF IT ISN'T BODY, CHECK FOR FACE OR EDGE.
TESTZ B,BBIT↔GO DOBODY
TESTZ B,FBIT↔GO DOFACE
TESTZ B,EBIT↔GO DOEDGE
POP1J ;FORGET IT.
;COPY FACE INTO A NEW BODY.
DOFACE: DAC B,OLDF↔PED E,B
SETQ(B,{BGET,OLDF}) ;BODY OF THE GIVEN FACE.
SETQ(BNEW,{MKB,[0]}) ;NEW BODY IN NOW WORLD.
FRAME Q,B↔SKIPE Q↔GO[ ;COPY BODY FRAME, IF ANY.
CALL(MKFRAME)↔FRAME. 1,BNEW
MOVSI XWC(Q)↔HRRI XWC(1)↔BLT KZ(1)
GO .+1]
SETQ(FACE,{MKF,BNEW})
SETQ(V,{MKV,BNEW})↔DAC V,V0
SETQ(A,{VCW,E,OLDF})↔DAC A,A0
L0: MOVSI XWC(A)↔HRRI XWC(V)↔BLT ZWC(V) ;COPY VERTEX LOCUS.
SETQ(A,{VCCW,E,OLDF}) ;ADVANCE A VERTEX.
SETQ(E,{ECCW,E,OLDF})
CAMN A,A0↔GO[ ;TEST FOR END.
CALL(MKFE,V0,FACE,V)↔LAC 1,FACE↔POP1J] ;MAKE LAST EDGE.
PUSHP A↔PUSHP E
SETQ(V,{MKEV,FACE,V})
POPP E↔POPP A
GO L0
DECLARE{OLDF,A0,V0,FACE,V1,V2}
DOEDGE: DAC B,E
PFACE F,E↔DAC F,FACE
PCW 1,E↔DAC 1,V1
PCCW 1,E↔DAC 1,V2
PVT 1,E↔DAC 1,A0
NVT 1,E↔DAC 1,V0
SETQ(V1,{ESPLIT,V1})↔LAC 2,A0
MOVSI XWC(2)↔HRRI XWC(1)↔BLT ZWC(1) ;COPY VERTEX LOCUS.
SETQ(V2,{ESPLIT,V2})↔LAC 2,V0
MOVSI XWC(2)↔HRRI XWC(1)↔BLT ZWC(1) ;COPY VERTEX LOCUS.
CALL(MKFE,V1,FACE,V2)
POP1J
;(MKCOPY continued)
;MAKE A NEW BODY NODE
DOBODY: SETQ(BNEW,{MKB,[0]})
FRAME Q,B↔SKIPE Q ;COPY BODY FRAME, IF ANY
GO[ CALL(MKFRAME)↔FRAME. 1,BNEW
MOVSI XWC(Q)↔HRRI XWC(1)↔BLT KZ(1)
GO .+1]
;COPY THRU BODY'S FACE RING
LAC B,ARG1↔LAC F,B↔LAC E,B↔LAC V,B
;FOR ALL THE EDGES OF THE BODY.
L1: PED E,E↔TEST E,EBIT↔GO L2
SETQ(Q,{MKE,BNEW})↔ALT. Q,E↔GO L1
;FOR ALL THE FACES OF THE BODY.
L2: PFACE F,F↔TEST F,FBIT↔GO L3
SETQ(Q,{MKF,BNEW})↔ALT. Q,F
PED A,F↔ALT A,A↔PED. A,Q
LAC QQ(F)↔DAC QQ(Q)↔GO L2
;FOR ALL THE VERTICES OF THE BODY.
L3: PVT V,V↔TEST V,VBIT↔GO L4
SETQ(Q,{MKV,BNEW})↔ALT. Q,V
PED A,V↔ALT A,A↔PED. A,Q
MOVSI XWC(V)↔HRRI XWC(Q)↔BLT ZWC(Q)
MOVSI XPP(V)↔HRRI XPP(Q)↔BLT YPP(Q)↔GO L3
;FOR ALL THE EDGES OF THE BODY.
L4: PED E,E↔TEST E,EBIT↔GO L5
ALT Q,E
PVT V,E↔ ALT V,V↔PVT. V,Q
NVT V,E↔ ALT V,V↔NVT. V,Q
PFACE F,E↔ALT F,F↔PFACE. F,Q
NFACE F,E↔ALT F,F↔NFACE. F,Q
NCW A,E↔ ALT A,A↔NCW. A,Q
PCW A,E↔ ALT A,A↔PCW. A,Q
NCCW A,E↔ ALT A,A↔NCCW. A,Q
PCCW A,E↔ ALT A,A↔PCCW. A,Q↔GO L4
L5: SETZ↔LAC 1,BNEW↔SKIPA E,ARG1
L6: ALT. 0,E↔PED E,E↔CAME E,ARG1↔GO L6
;PARTS OF THIS BODY.
LAC B,ARG1↔TESTZ B,BDPBIT↔POP1J
SON Q,B↔JUMPE Q,POP1J.
L7: PUSH P,Q↔PUSH P,BNEW↔CALL(MKCOPY,Q)
LAC BNEW,(P)↔CALL(BATT,1,BNEW)
POP P,BNEW↔POP P,Q↔LAC B,ARG1
BRO Q,Q↔SON 0,B↔CAME 0,Q↔GO L7
LAC 1,BNEW↔POP1J
ENDR;1/14/73(BGB)----------------------------------------------------
SUBR(UNGLUE,EDGE)
ACCUMULATORS{B,F,FNEW,E,E1,E2,V,B2,Q,R}
;FETCH WASP EDGE & ITS BODY AND FACE.
LAC E,EDGE↔PFACE F,E↔CCW B,E
;ELIMINATE THE WASP EDGE.
PVT V,E↔DAC V,Q
SETQ(E1,{ECCW,E,V})↔SETQ(E2,{ECW,E,V}) ;FETCH WINGS OF PVT(E).
CALL(WING,E1,E2)↔PED. E1,V
PED. E1,F↔NVT V,E
SETQ(E1,{ECCW,E,V})↔SETQ(E2,{ECW,E,V}) ;FETCH WINGS OF NVT(E).
CALL(WING,E1,E2)↔PED. E1,V
CALL(KLE,B,E)
;MAKE NEW FACE FOR ONE OF THE PERIMETERS.
SETQ(FNEW,{MKF,B})
LAC E,E1
L00: CALL(ECCW,E,F)
PFACE 0,E↔CAMN 0,F↔PFACE. FNEW,E
NFACE 0,E↔CAMN 0,F↔NFACE. FNEW,E
LAC E,1↔CAME E,E1↔GO L00↔PED. E,FNEW
;MARK ALL THE FACES, EDGES AND VERTICES OF ONE BODY.
PVT V,E↔SETZM 6(V)
L0: MARK V,TMPBIT
L1: PED E1,V↔LAC E,E1
L2: TEST E,TMPBIT↔GO[ MARK E,TMPBIT
PFACE F,E↔MARK F,TMPBIT
NFACE F,E↔MARK F,TMPBIT
CALL(OTHER,E,V)
TESTZ 1,TMPBIT↔GO .+1
ALT. V,1↔LAC V,1↔GO L0] ;PUSH VERTEX.
SETQ(E,{ECCW,E,V})
CAME E,E1↔GO L2
ALT V,V↔SKIPE V↔GO L1 ;POP VERTEX.
;PLACE ALL THE MARKED F.E.V. ON A NEW BODY.
LAC B2,B↔TESTZ Q,TMPBIT↔GO L6 ;KILL HOLE.
SETQ(B2,{MKB,B}) ;MAKE BODY.
L3: SKIPA F,B↔SKIPA F,R↔PFACE F,F
TESTZ F,TMPBIT↔GO .+4↔CAMN F,B↔GO L4↔GO L3+2
NFACE Q,F↔PFACE R,F↔PFACE. R,Q↔NFACE. Q,R↔NFACE Q,B2
PFACE. F,Q↔NFACE. F,B2↔NFACE. Q,F↔PFACE. B2,F↔GO L3+1
L4: SKIPA E,B↔SKIPA E,R↔PED E,E
TESTZ E,TMPBIT↔GO .+4↔CAMN E,B↔GO L5↔GO L4+2
NED Q,E↔PED R,E↔PED. R,Q↔NED. Q,R↔NED Q,B2
PED. E,Q↔NED. E,B2↔NED. Q,E↔PED. B2,E↔CCW. B2,E↔GO L4+1
L5: SKIPA V,B↔SKIPA V,R↔PVT V,V
TESTZ V,TMPBIT↔GO .+4↔CAMN V,B↔GO L6↔GO L5+2
NVT Q,V↔PVT R,V↔PVT. R,Q↔NVT. Q,R↔NVT Q,B2
PVT. V,Q↔NVT. V,B2↔NVT. Q,V↔PVT. B2,V↔GO L5+1
L6: MOVSI(TMPBIT)
LAC F,B2↔PFACE F,F↔CAME F,B2↔GO[ANDCAM(F)↔GO .-2]
LAC E,B2↔PED E,E↔CAME E,B2↔GO[ANDCAM(E)↔GO .-2]
LAC V,B2↔PVT V,V↔CAME V,B2↔GO[ANDCAM(V)↔GO .-2]
LAC 1,FNEW↔POP1J
ENDR UNGLUE;1/11/74(BGB)---------------------------------------------
SUBR(GLUEE,FACE1,VERT1,FACE2,VERT2)
COMMENT ⊗-----------------------------------------------------------
ENEW ← GLUEE(F1,V1,F2,V2) - LIKE TWO MKEV(F,V)'S BACK TO BACK.
⊗
Q←1
ACCUMULATORS{F1,V1,F2,V2,B,E,E1,E2,E3,E4}
L0: CDR F1,FACE1↔CDR V1,VERT1↔PED E,F1↔CCW B,E
CDR F2,FACE2↔CDR V2,VERT2↔PED E,F2↔CCW 1,E
DAC E,E0#↔CAMN 1,B↔GO L1
;REPLACE B2 WITH B1 IF THEY ARE DIFFERENT.
LAC E,1↔PED E,E↔CAME E,1↔GO[CCW. B,E↔GO .-2]
PFACE E1,1↔NFACE E2,1↔NFACE E3,B
PFACE. E1,E3↔NFACE. E3,E1
PFACE. B,E2↔NFACE. E2,B
PED E1,1↔NED E2,1↔NED E3,B
PED. E1,E3↔NED. E3,E1
PED. B,E2↔NED. E2,B
PVT E1,1↔NVT E2,1↔NVT E3,B
PVT. E1,E3↔NVT. E3,E1
PVT. B,E2↔NVT. E2,B
CALL(KLB,1)↔GO L0
;REPLACE F2 WITH F1.
L1: PFACE Q,E↔CAMN Q,F2↔PFACE. F1,E
NFACE Q,E↔CAMN Q,F2↔NFACE. F1,E
SETQ(E,{ECCW,E,F1})
CAME E,E0↔GO L1
CALL(KLF,B,F2)
COMMENT . GLUEE MANDALA
| | |
| +V2 |
| / | \ |
| / | \ |
NCCW | E2/ | \E1 | PCW
| / | \ |
| / F2 | F2 \ |
o______ | ______o
| HOWEVER,
WASP | ENEW GLUEE RETURN'S ENEW INVERTED
o______ | ______o
|\ | /|
| \ F1 | F1 / |
| \ | / |
NCW | E3\ | /E4 | PCCW
| \ | / |
| \ | / |
| -V1 |
| | |
| | | .
;EDGE CREATION
SETQ(E,{MKE,B})
MARK E,WASP
NFACE. F1,E↔PFACE. F1,E
NVT. V1,E↔PVT. V2,E
;MAKE WINGS
SETQ(E1,{ECW,V2,F1})↔PCW. E1,E
SETQ(E2,{ECW,E1,V2})↔NCCW. E2,E
SETQ(E3,{ECW,V1,F1})↔NCW. E3,E
SETQ(E4,{ECW,E3,V1})↔PCCW. E4,E
PVT Q,E1↔CAME Q,V2↔GO[PCCW. E,E1↔GO .+2]↔NCCW. E,E1
PVT Q,E2↔CAME Q,V2↔GO[NCW. E,E2↔GO .+2]↔PCW. E,E2
PVT Q,E3↔CAME Q,V1↔GO[PCCW. E,E3↔GO .+2]↔NCCW. E,E3
PVT Q,E4↔CAME Q,V1↔GO[NCW. E,E4↔GO .+2]↔PCW. E,E4
;MARK WASP WAIST ON POTENTIAL SPUR STARTING AT V1.
CAME E1,E2↔GO L2
MARK E1,WASP↔PVT V1,E1↔PED E1,V1
MOVS Q,1(E1)↔CAMN Q,1(E1)↔GO .-5
L2: LAC Q,E↔CALL(INVERT,Q)↔POP4J
ENDR;1/14/73(BGB)----------------------------------------------------
SUBR(GLUE)F1,F2
COMMENT ⊗-----------------------------------------------------------
⊗
EXTERN DISTAN
;ARGUMENTS MUST BE FACES WITH THE SAME NUMBER OF VERTICES.
LAC 1,ARG1↔DAC 1,F1↔TEST 1,FBIT↔POP2J
LAC 1,ARG2↔DAC 1,F2↔TEST 1,FBIT↔POP2J
LAC 1,F1↔PED 2,1↔DAC 2,E↔DAC 2,E0↔MOVEI 10,1
L1: SETQ(E,{ECCW,E,F1})↔CAME 1,E0↔AOJA 10,L1↔DAC 10,NN
LAC 1,F2↔PED 2,1↔DAC 2,E↔DAC 2,E0↔SOS 10
L2: SETQ(E,{ECCW,E,F2})↔CAME 1,E0↔SOJA 10,L2↔SKIPE 10↔POP2J
;FIND V2 CLOSEST TO V1.
LAC 1,F1↔PED 2,1↔SETQ(V1,{VCW,2,1})
HRLOI 377777↔DAC MIN
SETZM LIST1↔SETZM LIST2
L3: SETQ(V,{VCW,E,F2})
CALL(DISTAN,V,V1)
CAMGE 1,MIN↔GO[DAC 1,MIN↔LAC V↔DAC V2↔GO .+1]
LAC 1,E↔LAC LIST1↔DAP -1(1)↔DAC 1,LIST1
; LAC 1,V↔LAC LIST2↔DAP -1(1)↔DAC 1,LIST2
SETQ(E,{ECCW,E,F2})
CAME 1,E0↔GO L3
CALL(GLUEE,F1,V1,F2,V2)
CALL(INVERT,1)
LAC LIST2↔DAP -1(1)↔DAC 1,LIST2
;CLOSE UP THE GAP.
SOS NN
L4: PCCW 0,1↔PUSH P,0↔PCW 0,1↔PUSH P,0
SETQ(V2,{OTHER,V2})↔SETQ(V1,{OTHER,V1})
CALL(MKFE,V2,F1,V1)
LAC LIST2↔DAP -1(1)↔DAC 1,LIST2
SOSLE NN↔GO L4
;NOW KILL ALL THOSE EDGES.
L5: SKIPN 1,LIST1↔GO L6↔CDR 0,-1(1)↔DAC 0,LIST1
CALL(KLFE,1)↔GO L5
L6: SKIPN 1,LIST2↔GO L7↔CDR 0,-1(1)↔DAC 0,LIST2
CALL(KLVE,1)↔GO L6
L7: LAC 1,F1↔PED 1,1↔CCW 1,1
POP2J
DECLARE{F1,F2,V,V1,V2,NN,E,E0,MIN,LIST1,LIST2}
ENDR;2/10/73(BGB)----------------------------------------------------
SUBR(SWEEP,FACE0,FLAG)
COMMENT .-----------------------------------------------------------
U2 o----------o U1 FACE SWEEP MANDALA
/ \ / \
/ \ FNEW / \
/ \____/ \
/ v2 v1 \
/ F \.
;TEST FOR VALID ARGUMENT.
LAC 1,FACE0↔DAC 1,F↔TEST 1,FBIT↔POP2J
PED 2,1↔DAC 2,E↔SKIPN 2↔POP2J
TEST 2,EBIT↔POP2J
HLRE 0,FLAG↔DAC 0,CURFLG↔HRRES FLAG ;SET CURVE FLAG.
;TEST FOR SPECIAL CASES.
PCW 3,2↔CAMN 3,2↔JCALL SWEEP2 ;WIRE SWEEP CASE.
SETZM E0↔NCNT 0,1↔MOVMM NN
SKIPE↔SETZM ARG1
;MAKE FIRST SPOKE.
CALL(VCW,E,F)↔DAC 1,U0↔DAC 1,U1
CALL(MKEV,F,U0)↔DAC 1,V0↔DAC 1,V1
PED 2,1↔MOVSI (NSHARP)↔SKIPE CURFLG↔ORM (2) ;SET NSHARP FOR CURVES
;COPY FACE PERIMETER LOOP.
L1: SETQ(U2,{VCCW,E,F}) ;ADVANCE ALONG RIM.
SETQ(E,{ECCW,E,F})
LAC 1,U2↔CAME 1,U0 ;MAKE NEXT SPOKE.
GO[CALL(MKEV,F,U2)↔SKIPN CURFLG↔GO .+2
PED 2,1↔MARK 2,NSHARP↔GO .+2] ;SET NSHARP FOR CURVES
LAC 1,V0↔DAC 1,V2
CALL(MKFE,V1,F,V2) ;CONNECT SPOKES.
SKIPN E0↔DAC 1,E0 ;NEW FIRST EDGE.
;SPLIT NEW FACE TO MAKE PRISMOIDS.
NFACE 0,1
SKIPGE ARG1↔GO[CALL(MKFE,V1,0,U2)↔GO .+3] ;CW -1.
SKIPLE ARG1↔GO[CALL(MKFE,U1,0,V2)↔GO .+1] ;CCW +1.
;TEST FOR END OF COPY LOOP.
LAC V2↔DAC V1
LAC U2↔DAC U1
SOSN NN↔GO .+3
CAME U0↔GO L1 ;EXIT WHEN NN=0 OR U2=U0
;EXIT.
LAC 0,E0↔LAC 1,F
PED. 0,1↔POP2J
DECLARE{F,E,E0,U0,U1,U2,V0,V1,V2,NN}
ENDR SWEEP;2/7/73(BGB)-----------------------------------------------
DECLARE{CURFLG}
SUBR(SWEEP2,FACE0,FLAG)
COMMENT . ⊗ ⊗-------⊗ ⊗-------⊗
+ | | | | |
PED(F) | | | | |PED(F)'
- | | | | |
⊗ ⊗ ⊗ V1→ ⊗-------⊗ ←V2
+ | | | | |
| | FNEW | F below | |
- | | | | |
⊗ ⊗ ⊗ ⊗ FNEW ⊗
+ | | | | |
| | | | |
- | | | | |
⊗ ⊗-------⊗ ⊗-------⊗ .
HLRE 1,ARG1↔DAC CURFLG↔HRRES ARG1 ;SET CURVE FLAG.
;COUNT THE EDGES IN THE WIRE.
LAC 3,FACE0↔DAC 3,FACE ;FACE
PED 1,3↔MOVEI 0,1 ;EDGE & NCNT.
LAC 2,1↔NCW 1,1
CAME 1,2↔AOJA 0,.-3 ;COUNT THE EDGES.
;MAKE "BOTTOM" EDGE.
DAC 1,E ;LAST EDGE.
NCNT. 0,3↔DAC NN
NVT 1,1 ;LAST VERTEX OF THE WIRE.
SETQ(V2,{MKEV,FACE,1}) ;BOTTOM EDGE.
PED 1,1
MOVSI (NSHARP)↔SKIPE CURFLG↔ORM (1) ;SET NSHARP FOR CURVES
;COPY THE WIRE.
L1: SETQ(V2,{MKEV,FACE,V2})
LAC 3,E↔PVT 2,3↔DAC 2,V1
MOVSI XWC(2)↔HRRI XWC(1)↔BLT ZWC(1)
PCW 2,3↔DAC 2,E↔CAME 2,3↔GO L1
;CLOSE THE TOP.
SETQ(E,{MKFE,V1,FACE,V2})
MOVSI (NSHARP)↔SKIPE CURFLG↔ORM (1) ;SET NSHARP FOR CURVES
NFACE 1,1↔DAC 1,FNEW
SOSG NN↔GO L3
;FOLLOW DOWN BOTH SIDES.
L2: CALL(ECCW,E,FNEW)↔SETQ(V1,{OTHER,1,V1})
CALL(ECW,E,FNEW)↔SETQ(V2,{OTHER,1,V2})
SETQ(E,{MKFE,V2,FNEW,V1})
MOVSI (NSHARP)↔SKIPE CURFLG↔ORM (1) ;SET NSHARP FOR CURVES
SOSLE NN↔GO L2
;UPDATE THE FIRST EDGE OF THE FACE.
L3: LAC 2,ARG2↔PED 1,2
CALL(ECCW,1,2)↔PED. 1,2
LAC 1,2↔POP2J
DECLARE{FACE,FNEW,NN,V1,V2,E}
ENDR SWEEP2;2/7/73(BGB)----------------------------------------------
SUBR(ROTCOM,FACE0) ;ROTATION SWEEP COMPLETION.
COMMENT .-----------------------------------------------------------
⊗---⊗---⊗----⊗---⊗
| GAP | ← POLE CAP
| ↓ |
⊗-----⊗←←←←⊗-----⊗ ← ARTIC CIRCLE
PED(F)→| |
| |
V1' ⊗←←←←⊗ V2'
| F |
| |
⊗-----⊗ ⊗-----⊗ ← ANTARTIC CIRCLE.
ACCUMULATORS{F,E,E0,M,N}
LAC F,FACE0↔DAC F,FACE↔TEST F,FBIT↔POP1J
NCNT N,F↔MOVMM N,NN↔SKIPN↔POP1J
;COUNT THE EDGES IN THIS FACE.
MOVEI M,1↔PED E,F↔DAC E,E0↔DAC E,EDGE
L1: SETQ(E,{ECCW,E,F})
CAME E,E0↔AOJA M,L1
;SKIP AROUND THE NORTH POLE CAP.
ASH M,-1↔SUB M,NN
SETQ(V1,{VCW,EDGE,FACE})
LAC 1,EDGE
L2: CALL(ECW,1,FACE)↔SOJG M,L2
SETQ(V2,{VCW,1,FACE})
SETQ(EDGE,{MKFE,V2,FACE,V1}) ;CLOSE THE TOP OF THE GAP.
;FOLLOW DOWN THE GAP.
L3: CALL(ECCW,EDGE,FACE)↔SETQ(V1,{OTHER,1,V1})
CALL(ECW,EDGE,FACE)↔SETQ(V2,{OTHER,1,V2})
SETQ(EDGE,{MKFE,V2,FACE,V1})
SOSLE NN↔GO L3
SETZ↔LAC 1,FACE↔NCNT. 0,1
POP1J
DECLARE{FACE,EDGE,V1,V2,NN}
ENDR;2/8/73(BGB)-----------------------------------------------------
SUBR(PYRAMID,FV) ;MAKE PYRAMID.
COMMENT ⊗-----------------------------------------------------------
⊗
LAC 1,ARG1↔TEST 1,VBIT↔GO L2
;VERTEX ARGUMENT - GIVEN THE PEAK FORM THE BASE.
DAC 1,V
PED 2,1↔DAC 2,E0↔DAC 2,E2
SETQ(V2,{OTHER,E2,V})
L1: LAC E2↔DAC E1
LAC V2↔DAC V1
SETQ(E2,{ECCW,E1,V})
SETQ(V2,{OTHER,E2,V})
CALL(LINKED,V1,V2)↔JUMPE 1,[ ;WHEN NOT LINKED.
CALL(FCCW,E1,V)
CALL(MKFE,V1,1,V2)↔GO .+1]
LAC E2↔CAME E0↔GO L1
LAC 1,ARG1↔POP1J
DECLARE{V,V1,V2,E0,E1,E2}
;FACE ARGUMENT - GIVEN THE BASE FORM THE PEAK.
L2: DAC 1,F↔TEST 1,FBIT↔POP1J
SETZM X↔SETZM Y↔SETZM Z↔SETZM N
PED 2,1↔DAC 2,E↔DAC 2,E0
SETQ(V0,{VCW,E0,F})
SETQ(PEAK,{MKEV,F,V0})
L3: SETQ(V,{VCCW,E,F})
LAC XWC(1)↔FADRM X
LAC YWC(1)↔FADRM Y
LAC ZWC(1)↔FADRM Z
AOS N↔CAMN 1,V0↔GO L4
SETQ(E,{ECCW,E,F})
CALL(MKFE,PEAK,F,V)
GO L3
L4: LAC 1,PEAK↔LAC 2,N↔FLOAT 2,
LAC X↔FDVR 2↔DAC XWC(1)
LAC Y↔FDVR 2↔DAC YWC(1)
LAC Z↔FDVR 2↔DAC ZWC(1)
POP1J
DECLARE{PEAK,F,E,V0,X,Y,Z,N}
ENDR;2/8/73(BGB)------------------------------------------------------
SUBR(REMOVF,FACE)
COMMENT ⊗-----------------------------------------------------------
⊗
LAC 1,FACE↔TEST 1,FBIT↔POP1J↔DAC 1,F
PED 2,1↔DAC 2,E
SETQ(V0,{VCW,E,F})
SETQ(V,{VCCW,E,F})↔MOVSI XWC(1)↔HRRI X↔BLT Z
SETQ(A,{ECCW,E,F})
SETQ(F,{KLFE,E})
MOVEI 1↔DAC N
L1: LAC 1,A↔DAC 1,E
PVT 0,1↔CAMN 0,V↔GO[CALL(INVERT,E)↔GO .+1]
SETQ(A,{ECCW,A,F})
SETQ(V,{KLVE,E})
LAC XWC(1)↔FADRM X
LAC YWC(1)↔FADRM Y
LAC ZWC(1)↔FADRM Z↔AOS N
CAME 1,V0↔GO L1
;PLACE VERTEX AT CENTER OF DECEASED FACE.
LAC 2,N↔FLOAT 2,
LAC X↔FDVR 2↔DAC XWC(1)
LAC Y↔FDVR 2↔DAC YWC(1)
LAC Z↔FDVR 2↔DAC ZWC(1)
POP1J
DECLARE{F,E,V,V0,A,X,Y,Z,N}
ENDR;2/10/73(BGB)----------------------------------------------------
SUBR(EKILL,EDGE)
COMMENT ⊗-----------------------------------------------------------
⊗
;PLACE PVT AT MIDPOINT OF E.
LAC 1,EDGE↔TEST 1,EBIT↔POP1J ;EDGE ARGUMENT.
PFACE 0,1↔DAC F1↔NFACE 0,1↔DAC F2 ;SAVE FACES.
NVT 2,1↔PVT 1,1
LAC XWC(1)↔FADR XWC(2)↔FSC -1↔DAC XWC(1)
LAC YWC(1)↔FADR YWC(2)↔FSC -1↔DAC YWC(1)
LAC ZWC(1)↔FADR ZWC(2)↔FSC -1↔DAC ZWC(1)
CALL(KLVE,EDGE)↔DAC 1,V
;KILL BIGON FACES WHEN THEY OCCUR.
LAC 1,F1↔PED 1,1
LAC 0,4(1)↔XOR 0,5(1)
TRNE 0,-1↔TLNN 0,-1
GO[CALL(KLFE,1)↔GO .+1]
LAC 1,F2↔PED 1,1
LAC 0,4(1)↔XOR 0,5(1)
TRNE 0,-1↔TLNN 0,-1
GO[CALL(KLFE,1)↔GO .+1]
LAC 1,V↔POP1J
DECLARE{F1,F2,V}
ENDR;11/21/73(BGB)---------------------------------------------------
SUBR(FVDUAL,BODY)
COMMENT ⊗-----------------------------------------------------------
⊗
ACCUMULATORS{B,F,E,V,E0,X,Y,Z,I}
LAC B,BODY↔TEST B,BBIT↔POP1J
;FOR ALL THE FACES OF THE BODY.
LAC F,B
L1: PFACE F,F↔CAMN F,BODY↔GO L3
SETZB X,Y↔SETZB Z,I
PED E,F↔DAC E,E0
;COMPUTE CENTER OF EACH FACE.
L2: SETQ(V,{VCCW,E,F})
SETQ(E,{ECCW,E,F})
FADR X,XWC(V)↔FADR Y,YWC(V)↔FADR Z,ZWC(V)
AOS I
CAME E,E0↔GO L2
;CONVERT FACES INTO VERTICES.
FLOAT I,↔FDVR X,I↔FDVR Y,I↔FDVR Z,I
DAC X,XWC(F)↔DAC Y,YWC(F)↔DAC Z,ZWC(F)
LAC 1(F)↔DAC 3(F)↔MOVE [VBIT+$VERT]↔DAC(F)
GO L1
;CONVERT VERTICES INTO FACES.
L3: LAC V,ARG1↔LAC 1,[FBIT+$FACE]↔LAC E,ARG1
L4: PVT V,V↔CAMN V,BODY↔GO L5
LAC 3(V)↔DAC 1(V)↔DAC 1,(V)↔GO L4
;TURN ALL THE EDGES OVER AND INSIDE OUT.
L5: PED E,E↔CAMN E,BODY↔GO L6
LAC 1(E)↔EXCH 3(E)↔DAC 1(E)
MOVSS 1(E)
MOVS 4(E)↔MOVE 1,5(E)
DAC 1,4(E)↔DAC 5(E)
GO L5
L6: LAC B,ARG1↔LAC 1(B)↔EXCH 3(B)↔DAC 1(B)
POP1J
ENDR;2/10/73(BGB)----------------------------------------------------
SUBR(MKCUBE,DX,DY,DZ)
COMMENT ⊗-----------------------------------------------------------
⊗
SETQ(B,{MKB,[0]}) ;MAKE SEMINAL BODY.
CALL(MKFRAME)↔LAC 2,B↔FRAME. 1,2 ;FRAME OF REFERENCE.
SETQ(F,{MKF,B})
SETQ(V,{MKV,B})
LAC DX↔FSC -1↔DAC XWC(1) ;POSITION 1ST VERTEX.
LAC DY↔FSC -1↔DAC YWC(1)
LAC DZ↔FSC -1↔DAC ZWC(1)
CALL(MKEV,F,1)↔MOVNS XWC(1) ;SWEEP WIRE SQUARE.
CALL(MKEV,F,1)↔MOVNS YWC(1)
CALL(MKEV,F,1)↔MOVNS XWC(1)
CALL(MKFE,V,F,1)
CALL(SWEEP,F,[0])
LAC 1,B
NVT 1,1↔MOVNS ZWC(1)
NVT 1,1↔MOVNS ZWC(1)
NVT 1,1↔MOVNS ZWC(1)
NVT 1,1↔MOVNS ZWC(1)
LAC 1,B
POP3J
DECLARE{B,F,V}
ENDR MKCUBE;3/16/73(BGB)--------------------------------------------
SUBR(MKCYLN,RADIUS,N,DZ)
COMMENT ⊗-----------------------------------------------------------
⊗
SETQ(B,{MKB,[0]}) ;MAKE SEMINAL BODY.
CALL(MKFRAME)↔LAC 2,B↔FRAME. 1,2;FRAME OF REFERENCE.
SETQ(F,{MKF,B})
SETQ(V,{MKV,B})↔DAC 1,V0
MOVM DZ↔FSC -1↔DAC ZWC(1) ;PICKUP ARGUMENTS.
MOVM RADIUS↔DAC XWC(1)
MOVM N↔FIXX↔CAIGE 3↔MOVEI 3
DAC CNT↔SOS CNT ;NUMBER OF SIDES-1.
FLOAT↔LAC 1,TWOPI↑
FDVR 1,0↔DAC 1,DELTA ;DELTA RADIANS.
L1: SETQ(V,{MKEV,F,V}) ;SWEEP WIRE POLYGON.
CALL(ROTATE↑,V,[0],[0],DELTA)
SOSLE CNT↔GO L1
CALL(MKFE,V0,F,V) ;CLOSE WIRE - MAKING LAMINA.
CALL(SWEEP,F,[0]) ;SWEEP FACE INTO SOLID.
MOVN DZ
CALL(TRANSL↑,F,[0],[0],0)
LAC 1,B
POP3J
DECLARE{DELTA,CNT,B,F,V,V0}
ENDR MKCYLN;7/19/73(BGB)----------------------------------------------
SUBR(MKBALL,RADIUS,M,N)
COMMENT ⊗-----------------------------------------------------------
⊗
SETQ(B,{MKB,[0]}) ;MAKE SEMINAL BODY.
CALL(MKFRAME)↔LAC 2,B↔FRAME. 1,2;FRAME OF REFERENCE.
SETQ(F,{MKF,B})
SETQ(V,{MKV,B})↔DAC 1,V0
MOVM RADIUS↔MOVNM YWC(1)
;PICKUP LONGITUDE COUNT.
MOVM M↔FIXX↔CAIGE 2↔MOVEI 2
DAC CNT↔SOS CNT ;NUMBER OF LONGITUDES-1.
FLOAT↔LAC 1,PI↑
FDVR 1,0↔DAC 1,DELTA↔FSC 1,-1 ;DELTA RADIANS.
CALL(ROTATE↑,V0,[0],[0],1) ;SET OFF FROM POLAR AXIS.
;SWEEP MERIDIAN WIRE FROM ANTARTIC TO ARTIC.
L1: SETQ(V,{MKEV,F,V}) ;SWEEP WIRE POLYGON.
CALL(ROTATE↑,V,[0],[0],DELTA)
SOSLE CNT↔GO L1
;PICKUP LATITUDE COUNT.
MOVM N↔FIXX↔CAIGE 3↔MOVEI 3
DAC CNT↔SOS CNT ;NUMBER OF LATITUDES-1.
FLOAT↔LAC 1,TWOPI↑
FDVR 1,0↔MOVNM 1,DELTA ;DELTA RADIANS.
;SWEEP MERIDIAN WIRE INTO SHELL EAST TO WEST.
L2: CALL(SWEEP,F,[0])
CALL(ROTATE↑,F,[0],DELTA,[0])
SOSLE CNT↔GO L2↔CALL(ROTCOM,F) ;CLOSE THE SHELL
LAC 1,B
POP3J
DECLARE{DELTA,CNT,B,F,V,V0}
ENDR MKBALL;7/19/73(BGB)----------------------------------------------
END
EULER.FAI - EOF.